home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibcalc.arc / PIBCALC.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-09  |  25KB  |  428 lines
  1. (*$V-,B-,C-,U-,R-,X-*)
  2. (* PIBCALC - Interactive Programmable Calculator *)
  3.  
  4. (*--------------------------------------------------------------------------*)
  5. (*                    PibCalc --- Programmable Calculator                   *)
  6. (*--------------------------------------------------------------------------*)
  7. (*                                                                          *)
  8. (*   Author:   Philip R. Burns                                              *)
  9. (*   Date:     March, 1985                                                  *)
  10. (*   Version:  1.0                                                          *)
  11. (*   Systems:  For MS-DOS on IBM PCs and close compatibles only.            *)
  12. (*                                                                          *)
  13. (*   Overview: PibCalc is an interactive desk calculator designed for use   *)
  14. (*             especially by programmers.  PibCalc tries to combine the     *)
  15. (*             features from better pocket calculators with the expression  *)
  16. (*             syntax of the common algorithmic programming languages.      *)
  17. (*                                                                          *)
  18. (*             PibCalc offers the following features:                       *)
  19. (*                                                                          *)
  20. (*                Integer and Real Floating Point Arithmentic               *)
  21. (*                Octal, Decimal, and Hexadecimal Bases.                    *)
  22. (*                The usual arithmetic operators.                           *)
  23. (*                Common mathematical functions.                            *)
  24. (*                User-defined variables.                                   *)
  25. (*                User-defined functions.                                   *)
  26. (*                                                                          *)
  27. (*    NEEDED PROGRAM FILES                                                  *)
  28. (*    --------------------                                                  *)
  29. (*                                                                          *)
  30. (*       The library file PIBCALC.LBR contains all of the needed files:     *)
  31. (*                                                                          *)
  32. (*         (1)  Program source files                                        *)
  33. (*                                                                          *)
  34. (*              PIBCALC.PAS     (main program)                              *)
  35. (*              SCREENROU.PAS                                               *)
  36. (*              DUPL.PAS                                                    *)
  37. (*              EDITHELP.PAS                                                *)
  38. (*              EDITSTRI.PAS                                                *)
  39. (*              INITCALC.PAS                                                *)
  40. (*              ERRORS.PAS                                                  *)
  41. (*              MATHROUT.PAS                                                *)
  42. (*              READLINE.PAS                                                *)
  43. (*              DISPLAY.PAS                                                 *)
  44. (*              GETTOK.PAS                                                  *)
  45. (*              ARITH.PAS                                                   *)
  46. (*              EXPRESSI.PAS                                                *)
  47. (*              SETGUYS.PAS                                                 *)
  48. (*              DOGUYS.PAS                                                  *)
  49. (*                                                                          *)
  50. (*         (2)  Program documentation file (on-line help)                   *)
  51. (*                                                                          *)
  52. (*              PIBCALC.HLP --- the text for the online HELP file.          *)
  53. (*                                                                          *)
  54. (*    Documentation                                                         *)
  55. (*    -------------                                                         *)
  56. (*                                                                          *)
  57. (*       The file PIBCALC.HLP contains more complete documentation on the   *)
  58. (*       use of the PibCalc features.  You should read this file through    *)
  59. (*       before using PibCalc for the first time.   PIBCALC.HLP can also be *)
  60. (*       read during a PibCalc session by entering the HELP command.        *)
  61. (*                                                                          *)
  62. (*    Compiling PibCalc                                                     *)
  63. (*    -----------------                                                     *)
  64. (*                                                                          *)
  65. (*       File PIBCALC.PAS is the main program source file, and contains     *)
  66. (*       include statements for the remaining source files.  Hence, to      *)
  67. (*       compile PibCalc, enter Turbo (preferably Turbo-87), declare        *)
  68. (*       PIBCALC.PAS to be the M)ain file, request compilation to a .COM    *)
  69. (*       file using O)ptions, and enter C)ompile.                           *)
  70. (*                                                                          *)
  71. (*       PibCalc uses REAL arithmetic extensively, so that it benefits      *)
  72. (*       considerably from the performance enhancement available from the   *)
  73. (*       8087 math co-processor.  If you have an 8087/80287 chip, you       *)
  74. (*       should compile PibCalc with TURBO-87.  Doing so will result in a   *)
  75. (*       CONSIDERABLE improvement in performance and accuracy.              *)
  76. (*                                                                          *)
  77. (*    Using PibCalc                                                         *)
  78. (*    -------------                                                         *)
  79. (*                                                                          *)
  80. (*       Once you have a compiled version of PibCalc, running it is         *)
  81. (*       quite straightforward:  just type                                  *)
  82. (*                                                                          *)
  83. (*               PIBCALC                                                    *)
  84. (*                                                                          *)
  85. (*       in response to the DOS prompt.                                     *)
  86. (*                                                                          *)
  87. (*       To leave PibCalc, type                                             *)
  88. (*                                                                          *)
  89. (*               EXIT                                                       *)
  90. (*                                                                          *)
  91. (*       when you get the PibCalc prompt.                                   *)
  92. (*                                                                          *)
  93. (*    Online Help                                                           *)
  94. (*    -----------                                                           *)
  95. (*                                                                          *)
  96. (*    If the file PIBCALC.HLP is located in the same directory as PIBCALC,  *)
  97. (*    and you execute PibCalc in that directory, then you can request the   *)
  98. (*    online help during execution of PibCalc by entering the HELP command. *)
  99. (*    If the file PIBCALC.HLP is not found, then no help will be displayed. *)
  100. (*                                                                          *)
  101. (*    The file PIBCALC.HLP also contains more details on the use of various *)
  102. (*    PibCalc features.   You should read it at least once before using     *)
  103. (*    PibCalc.                                                              *)
  104. (*                                                                          *)
  105. (*--------------------------------------------------------------------------*)
  106. (*                                                                          *)
  107. (*    Possible Improvements                                                 *)
  108. (*    ---------------------                                                 *)
  109. (*                                                                          *)
  110. (*       (1)  PibCalc would benefit from the addition of complex            *)
  111. (*            arithmetic.                                                   *)
  112. (*       (2)  Additional functions to evaluate special mathematical and     *)
  113. (*            statistical distributions would be useful.                    *)
  114. (*       (3)  A more comprehensive programming facility allowing for        *)
  115. (*            saving up statements, flow of control, and conditional        *)
  116. (*            branching would be nice.                                      *)
  117. (*       (4)  > 16 bit integer arithmetic.                                  *)
  118. (*       (5)  Better trigonometric functions.                               *)
  119. (*                                                                          *)
  120. (*       Any Volunteers?????                                                *)
  121. (*                                                                          *)
  122. (*--------------------------------------------------------------------------*)
  123. (*                                                                          *)
  124. (*    Glitches                                                              *)
  125. (*    --------                                                              *)
  126. (*                                                                          *)
  127. (*       (1)  Turbo version 2.0 only allows 16-bit integers.  Hence, any    *)
  128. (*            integer expression outside this range will result in bad      *)
  129. (*            results.  Hopefully a later version will implement 32-bit     *)
  130. (*            integers as provided by the 8087.  To allow for this,         *)
  131. (*            the type LONG_INTEGER is used to refer to integer values.     *)
  132. (*            With version 2.0 of Turbo, this is just the ordinary 16-bit   *)
  133. (*            integers.  If longer integers become available, change        *)
  134. (*            the definition of LONG_INTEGER to refer to these longer       *)
  135. (*            integers.                                                     *)
  136. (*                                                                          *)
  137. (*       (2)  A large part of PibCalc was previously implemented in a       *)
  138. (*            mainframe dialect of Pascal.  This Pascal, like the standard, *)
  139. (*            allowed out-of-block GOTOs.  Out-of-block GOTOs are VERY      *)
  140. (*            useful for getting out layers of recursive descent when       *)
  141. (*            parsing or executing a stack of operations.  Regrettably,     *)
  142. (*            Turbo Pascal does NOT allow out-of-block GOTOs, resulting in  *)
  143. (*            a considerable amount of less-than-elegant code to check and  *)
  144. (*            re-check if global error flags have been set.                 *)
  145. (*                                                                          *)
  146. (*--------------------------------------------------------------------------*)
  147. (*                                                                          *)
  148. (*    Credits:                                                              *)
  149. (*    --------                                                              *)
  150. (*                                                                          *)
  151. (*       PibCalc is based in part on John Norstad's DCALC, in part on a     *)
  152. (*       previous mainframe calculator program I wrote, and in part on a    *)
  153. (*       number of other similar calculator programs.                       *)
  154. (*                                                                          *)
  155. (*       The WordStar-like string editing routine (for editing the last     *)
  156. (*       command line or a function definition) is modified from a routine  *)
  157. (*       I found on a BBS.  My thanks to the anonymous author of the        *)
  158. (*       original.                                                          *)
  159. (*                                                                          *)
  160. (*--------------------------------------------------------------------------*)
  161. (*                                                                          *)
  162. (*    Where to send fan mail and letter bombs:                              *)
  163. (*    ----------------------------------------                              *)
  164. (*                                                                          *)
  165. (*       Suggestions for improvements or corrections are welcome.           *)
  166. (*       Please leave messages on Gene Plantz's BBS (312) 882 4227          *)
  167. (*       or Ron Fox's BBS (312) 940 6496.                                   *)
  168. (*                                                                          *)
  169. (*       I hope that you find this program useful -- and, if you expand     *)
  170. (*       please upload your extensions so that all of us can enjoy them!    *)
  171. (*                                                                          *)
  172. (*--------------------------------------------------------------------------*)
  173.  
  174. (*--------------------------------------------------------------------------*)
  175. (*                           Global Constants                               *)
  176. (*--------------------------------------------------------------------------*)
  177.  
  178. CONST
  179.  
  180.    MaxLint      = 32767            (* Maximum value of long integer       *);
  181.    Maxstrlen    = 255              (* Maximum string length               *);
  182.    Maxstdfuncs  = 25               (* Number of built-in functions        *);
  183.    Maxuserfuncs = 20               (* Maximum number of user functions    *);
  184.    Maxformal    = 10               (* Maximum number of formal parameters *);
  185.    Maxtoknams   = 18               (* Maximum number of syntactic tokens  *);
  186.  
  187.                                    (* Base of the Naperian Logarithms     *)
  188.    EE           = 2.718281828459045;
  189.                                    (* Guess what?                         *)
  190.    PI           = 3.141592653589793;
  191.  
  192.    col          = 'a'              (* End of string marker                *) ;
  193.  
  194.    cr           = #13              (* Carriage return character           *);
  195.    bs           = #08              (* Backspace character                 *);
  196.    Ctrlx        = ^x               (* Line delete character               *);
  197.    Ctrld        = ^d               (* Move right character                *);
  198.    Ctrls        = ^s               (* Move left character                 *);
  199.    Ctrlh        = ^h               (* Alternate move left character       *);
  200.    Ctrlf        = ^f               (* Move to end of line character       *);
  201.    Ctrla        = ^a               (* Move to front of line character     *);
  202.    Ctrlv        = ^v               (* Toggle insert/delete mode           *);
  203.  
  204. (*--------------------------------------------------------------------------*)
  205. (*                              Global Types                                *)
  206. (*--------------------------------------------------------------------------*)
  207.  
  208. TYPE
  209.                                    (* Command names/user funcs/constants *)
  210.  
  211.    Alfa      = PACKED ARRAY[1..10] OF CHAR;
  212.  
  213.                                    (* General string *)
  214.    AnyStr    = STRING[Maxstrlen];
  215.                                    (* Change to long integer type if poss. *)
  216.    Long_Integer = INTEGER;
  217.                                    (* Command type *)
  218.  
  219.    tokenty = ( exitsy,     helpsy,     decsy,      octsy,      hexsy,
  220.                fracsy,     radsy,      degsy,      defsy,      delsy,
  221.                showsy,     varssy,     funcssy,    modsy,      divsy,
  222.                varsy,      constsy,    eolsy,      stdfuncsy,  userfuncsy,
  223.                plussy,     minussy,    starsy,     slashsy,    exponsy,
  224.                oparsy,     cparsy,     equalssy,   commasy,    dollarsy,
  225.                periodsy,   editsy );
  226.  
  227.                                    (* Variable names are 'A' through 'Z' *)
  228.    varnamty = 'A'..'Z';
  229.                                    (* Types of values are integer and real *)
  230.    varty = ( int, rea );
  231.  
  232.                                    (* Defined value type *)
  233.    valuety = RECORD
  234.                 def:  BOOLEAN      (* If value assigned yet *);
  235.                 typ:  varty        (* Which value applies -- integer or real *);
  236.                 i:    Long_Integer (* Integer value *);
  237.                 r:    REAL         (* Real value *);
  238.              END;
  239.                                    (* Bases for arithmetic *)
  240.    basety = ( dec, oct, hex );
  241.  
  242.    charsetty = SET OF CHAR;
  243.  
  244.                                    (* Built-in functions/constants *)
  245.  
  246.    stdfuncty = ( absf,    minf,    maxf,    truncf,    roundf,
  247.                  sinf,    cosf,    tanf,    cotf,      secf,
  248.                  cscf,    asinf,   acosf,   atanf,     acotf,
  249.                  asecf,   acscf,   atan2f,  expf,      lnf,
  250.                  log10f,  logf,    sqrtf,   EEf,       PIf      );
  251.  
  252.                                     (* Formal parameters for user function *)
  253.    formalty = RECORD
  254.                  nump:  INTEGER     (* Number of formal parameters *);
  255.                  parms: ARRAY [1..maxformal] OF
  256.                            RECORD
  257.                               name: varnamty   (* Name of formal parameter *);
  258.                               VAL:  valuety    (* Value type of formal par. *);
  259.                            END
  260.               END;
  261.                                    (* Angle calcs -- degrees or radians *)
  262.    anglety = ( rad, deg );
  263.  
  264. (*--------------------------------------------------------------------------*)
  265. (*                          Global Variables                                *)
  266. (*--------------------------------------------------------------------------*)
  267.  
  268. VAR
  269.  
  270.    UseEdit:   BOOLEAN              (* TRUE to use edited line            *);
  271.    ErrorFlag: BOOLEAN              (* Execution time error flag          *);
  272.    HelpFile:  TEXT                 (* File containing help text          *);
  273.    Iline:     AnyStr               (* Command input line                 *);
  274.    Oline:     AnyStr               (* Saved command input line           *);
  275.    Ipos:      INTEGER              (* Current position in command line   *);
  276.    token:     tokenty              (* Current token from command line    *);
  277.    varnam:    varnamty             (* Variable name if token = varsy     *);
  278.    constval:  valuety              (* Constant value if token = constsy  *);
  279.    istdfunc:  INTEGER              (* Index into Stdfuncs table if token *)
  280.                                    (* = Stdfuncsy                        *);
  281.    iuserfunc: INTEGER              (* Index in userfuncs table if token  *)
  282.                                    (* = Userfuncsy                       *);
  283.    curval:    valuety              (* Current accumulator value          *);
  284.  
  285.                                    (* Current variable values            *)
  286.    VarVals:   ARRAY[varnamty] OF valuety;
  287.  
  288.    done:      BOOLEAN              (* TRUE when time to quit PibCalc     *);
  289.    base:      basety               (* Current default base               *);
  290.    Frac:      INTEGER              (* No. of digits to display after     *)
  291.                                    (* decimal point.                     *);
  292.  
  293.    angle:     anglety              (* Current angle units -- rad or deg  *);
  294.    dummy:     formalty             (* Dummy (Empty) formal param. list   *);
  295.  
  296.                                    (* Standard Functions                 *)
  297.    stdfuncs:  ARRAY[ 1 .. Maxstdfuncs ] OF
  298.                  RECORD
  299.                     name:   alfa        (* Function name             *);
  300.                     nparms: INTEGER     (* No. of formal parameters  *);
  301.                     func:   stdfuncty   (* Type of built-in function *);
  302.                  END;
  303.  
  304.                                    (* User-defined functions *)
  305.    userfuncs: ARRAY[ 1 .. Maxuserfuncs ] OF
  306.                  RECORD
  307.                     name:   alfa        (* Function name             *);
  308.                     nparms: INTEGER     (* No. of formal parameters  *);
  309.                                         (* Parameter names           *)
  310.                     pnames: PACKED ARRAY [1..maxformal] OF varnamty;
  311.                     defn:   AnyStr      (* Function definition text  *);
  312.                  END;
  313.  
  314.                                    (* Commands/constants/func names  *)
  315.  
  316.    toknams:   ARRAY[ 1 .. Maxtoknams ] OF
  317.                  RECORD
  318.                     name: alfa     (* Token name *);
  319.                     tok:  tokenty  (* Token type *);
  320.                  END;
  321.  
  322. (*-----------------------------------------------------------------------*)
  323. (*                   Global Color Variables                              *)
  324. (*-----------------------------------------------------------------------*)
  325.  
  326. VAR
  327.  
  328.    ForeGround_Color    : INTEGER   (* Color for ordinary text           *);
  329.    BackGround_Color    : INTEGER   (* Usual background color            *);
  330.    Help_Text_Color     : INTEGER   (* Help text color                   *);
  331.    Help_Header_Color   : INTEGER   (* Help header color                 *);
  332.    Prompt_Color        : INTEGER   (* Color for prompts                 *);
  333.    Error_Message_Color : INTEGER   (* Color for error messages          *);
  334.  
  335. (*-----------------------------------------------------------------------*)
  336. (*                           Screen Types                                *)
  337. (*-----------------------------------------------------------------------*)
  338.  
  339. CONST
  340.  
  341.      Color_Screen_Address   = $B800;   (* Address of color screen          *)
  342.      Mono_Screen_Address    = $B000;   (* Address of mono screen           *)
  343.      Screen_Length          = 4000;    (* 80 x 25 x 2 = screen area length *)
  344.  
  345. TYPE
  346.                                               (* A screen image            *)
  347.    Screen_Type       = Array[ 1 .. Screen_Length ] Of BYTE;
  348.  
  349.    Screen_Ptr        = ^Screen_Image_Type;
  350.    Screen_Image_Type = RECORD
  351.                           Screen_Image: Screen_Type;
  352.                        END;
  353.  
  354. (*--------------------------------------------------------------------------*)
  355. (*                         Screen Variables                                 *)
  356. (*--------------------------------------------------------------------------*)
  357.  
  358. VAR
  359.                                    (* Memory-mapped screen area *)
  360.    Actual_Screen        : Screen_Ptr;
  361.  
  362. (*--------------------------------------------------------------------------*)
  363. (*                       Included Routines                                  *)
  364. (*--------------------------------------------------------------------------*)
  365.  
  366. PROCEDURE NextTok;
  367.    FORWARD;
  368.  
  369. (*$I SCREENROU.PAS *)
  370. (*$I DUPL.PAS      *)
  371. (*$I EDITHELP.PAS  *)
  372. (*$I EDITSTRI.PAS  *)
  373. (*$I INITCALC.PAS  *)
  374. (*$I ERRORS.PAS    *)
  375. (*$I MATHROUT.PAS  *)
  376. (*$I READLINE.PAS  *)
  377. (*$I DISPLAY.PAS   *)
  378. (*$I GETTOK.PAS    *)
  379. (*$I ARITH.PAS     *)
  380. (*$I EXPRESSI.PAS  *)
  381. (*$I SETGUYS.PAS   *)
  382. (*$I DOGUYS.PAS    *)
  383.  
  384. (* ----------------------------------------------------------------- *)
  385.  
  386. BEGIN (* PibCalc -- Main Program *)
  387.  
  388.                                    (* Initialize PibCalc execution *)
  389.    Initialize;
  390.                                    (* Display welcome              *)
  391.  
  392.    WRITELN('PibCalc version 1.0 ready.  Type HELP for instructions.');
  393.  
  394.                                    (* Loop over command lines      *)
  395.    REPEAT
  396.                                    (* No errors found this line    *)
  397.       Errorflag := FALSE;
  398.                                    (* Read command line            *)
  399.       ReadLine;
  400.                                    (* Pick up first token on line  *)
  401.       NextTok;
  402.                                    (* And execute appropriate task *)
  403.       IF ( NOT ErrorFlag ) THEN
  404.          CASE token OF
  405.  
  406.             exitsy:    DoExit;
  407.             helpsy:    DoHelp;
  408.             decsy:     SetBase ( dec );
  409.             octsy:     SetBase ( oct );
  410.             hexsy:     SetBase ( hex );
  411.             radsy:     SetAngle( rad );
  412.             degsy:     SetAngle( deg );
  413.             fracsy:    SetFrac;
  414.             showsy:    DoShow;
  415.             defsy:     DoDef;
  416.             delsy:     DoDel;
  417.             dollarsy:  DoEsp;
  418.             eolsy:     Display(' ',Curval);
  419.             editsy:    DoEdit;
  420.  
  421.          ELSE
  422.             DoExp;
  423.          END  (* Case *);
  424.  
  425.    UNTIL done;
  426.  
  427. END (* PibCalc *).
  428.